home *** CD-ROM | disk | FTP | other *** search
/ Shareware Overload Trio 2 / Shareware Overload Trio Volume 2 (Chestnut CD-ROM).ISO / dir43 / qsrc_dsk.zip / MODEL / PRODUCT / PRODUCT1.SPR < prev    next >
Text File  |  1991-12-16  |  5KB  |  152 lines

  1. *       ╓─────────────────────────────────────────────────────────╖
  2. *       ║                                                         ║
  3. *       ║ 12/16/91             PRODUCT1.SPR              15:15:03 ║
  4. *       ║                                                         ║
  5. *       ╟─────────────────────────────────────────────────────────╢
  6. *       ║                                                         ║
  7. *       ║ Application Developed in _Using FoxPro 2_               ║
  8. *       ║                                                         ║
  9. *       ║ Copyright (c) 1991 Lisa C. Slater and Steven E. Arnott  ║
  10. *       ║ Que Publishing (800)-428-5331                           ║
  11. *       ║ City,     Zip                                           ║
  12. *       ║                                                         ║
  13. *       ║ Description:                                            ║
  14. *       ║ This program was automatically generated by GENSCRN.    ║
  15. *       ║                                                         ║
  16. *       ╙─────────────────────────────────────────────────────────╜
  17.  
  18. #REGION 0
  19. REGIONAL m.currarea, m.talkstat, m.compstat
  20.  
  21. IF SET("TALK") = "ON"
  22.     SET TALK OFF
  23.     m.talkstat = "ON"
  24. ELSE
  25.     m.talkstat = "OFF"
  26. ENDIF
  27. m.compstat = SET("COMPATIBLE")
  28. SET COMPATIBLE FOXPLUS
  29.  
  30. *       ╓─────────────────────────────────────────────────────────╖
  31. *       ║                                                         ║
  32. *       ║                    Window definitions                   ║
  33. *       ║                                                         ║
  34. *       ╙─────────────────────────────────────────────────────────╜
  35. *
  36.  
  37. DEFINE WINDOW product ;
  38.     FROM INT((SROW()-7)/2),INT((SCOL()-35)/2) ;
  39.     TO INT((SROW()-7)/2)+6,INT((SCOL()-35)/2)+34 ;
  40.     TITLE " PRODUCT " ;
  41.     FLOAT ;
  42.     CLOSE ;
  43.     SHADOW ;
  44.     COLOR SCHEME 1
  45.  
  46.  
  47. *       ╓─────────────────────────────────────────────────────────╖
  48. *       ║                                                         ║
  49. *       ║             PRODUCT1 Setup Code - SECTION 2             ║
  50. *       ║                                                         ║
  51. *       ╙─────────────────────────────────────────────────────────╜
  52. *
  53.  
  54. #REGION 1
  55. * #REDEFINE generator directive in case
  56. * file has been interactively BROWSEd under
  57. * WIDGET.MPR, which would result in a window
  58. * of the same name already existing because we
  59. * named these windows the same as the files!
  60. * A browse window is named by its title and
  61. * its default title is its ALIAS.
  62.  
  63. *       ╓─────────────────────────────────────────────────────────╖
  64. *       ║                                                         ║
  65. *       ║                 PRODUCT1 Screen Layout                  ║
  66. *       ║                                                         ║
  67. *       ╙─────────────────────────────────────────────────────────╜
  68. *
  69.  
  70. #REGION 1
  71. IF WVISIBLE("product")
  72.     ACTIVATE WINDOW product SAME
  73. ELSE
  74.     ACTIVATE WINDOW product NOSHOW
  75. ENDIF
  76. @ 1,1 SAY "Prodcode"
  77. @ 1,11 GET prodcode ;
  78.     SIZE 1,5 ;
  79.     DEFAULT " " ;
  80.     PICTURE "@! AAA99" ;
  81.     VALID _q1f0wynfr() ;
  82.     ERROR IIF(EMPTY(prodcode), "Product code cannot be empty.", "Product code already in use.")
  83. @ 3,1 SAY "Prodname"
  84. @ 3,11 GET prodname ;
  85.     SIZE 1,20 ;
  86.     DEFAULT " "
  87.  
  88. IF NOT WVISIBLE("product")
  89.     ACTIVATE WINDOW product
  90. ENDIF
  91.  
  92. READ CYCLE
  93.  
  94. RELEASE WINDOW product
  95.  
  96. #REGION 0
  97. IF m.talkstat = "ON"
  98.     SET TALK ON
  99. ENDIF
  100. IF m.compstat = "ON"
  101.     SET COMPATIBLE ON
  102. ENDIF
  103.  
  104.  
  105. *       ╓─────────────────────────────────────────────────────────╖
  106. *       ║                                                         ║
  107. *       ║ _Q1F0WYNFR           prodcode VALID                     ║
  108. *       ║                                                         ║
  109. *       ║ Function Origin:                                        ║
  110. *       ║                                                         ║
  111. *       ║ From Screen:         PRODUCT1,     Record Number:    4  ║
  112. *       ║ Variable:            prodcode                           ║
  113. *       ║ Called By:           VALID Clause                       ║
  114. *       ║ Object Type:         Field                              ║
  115. *       ║ Snippet Number:      1                                  ║
  116. *       ║                                                         ║
  117. *       ╙─────────────────────────────────────────────────────────╜
  118. *
  119. FUNCTION _q1f0wynfr     &&  prodcode VALID
  120. #REGION 1
  121. IF EMPTY(prodcode)
  122.    * it shouldn't be blank
  123.    RETURN .F.
  124. ENDIF
  125. IF RECCOUNT() = 0
  126.   * don't bother checking if
  127.   * first record
  128.   RETURN .T.
  129. ENDIF
  130. mcode = prodcode
  131. mreturn = .T.
  132. mrec = IIF(EOF(),0,RECNO())
  133. morder = ORDER()
  134. SET ORDER TO prodcode
  135. IF SEEK(mcode)
  136.    IF RECNO() # mrec
  137.        mreturn = .F.
  138.     ELSE
  139.        SKIP
  140.        IF prodcode == mcode
  141.           mreturn = .F.
  142.        ENDIF
  143.     ENDIF
  144. ENDIF
  145. SET ORDER TO (morder)
  146. IF mrec = 0
  147.   GO BOTTOM
  148.   SKIP
  149. ELSE
  150.   GO mrec
  151. ENDIF
  152. RETURN mreturn